unit JATUIF_Component_VScrollBar;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Video, JATUIF_Component, JATUIF_Driver_Screen, JATUIF_Component_SmallButton;

Type

    { TVScrollBar }

    TVScrollBar = class(TComponent)
      Protected
        Procedure SetVisible(Vis:Boolean); override;
        Procedure _OnKeyPress(Key:Char); override;
        Procedure _OnMouseEnter; override;
        Procedure _OnMouseLeave; override;
        Procedure _OnClick; override;
        Procedure _OnLoseFocus; override;
        Procedure Draw; override;
      Private
        TrackSize:Integer;
        GripSize:Integer;
        WindowSize:Integer;
        ContentSize:Integer;
        WindowPosition:Integer;
        btn_Up:TSmallButton;
        btn_Down:TSmallButton;
        X1,Y1,X2,Y2:Integer;
        _OnClick_Down:TComponent_Focus;
        _OnClick_Up:TComponent_Focus;
        Procedure btn_UpClick;
        Procedure btn_DownClick;
        Procedure Dummy_ScrollClick;
      Public
        Constructor Create(Parent: TScreen; X, Y, Height:Integer);
        Procedure UpdateContentSize(Size:Integer);
        Procedure UpdateWindowPosition(Position:Integer);
        Procedure SetWindowSize(Size:Integer);
        Property OnClick_Up : TComponent_Focus write _OnClick_Up;
        property OnClick_Down : TComponent_Focus write _OnClick_Down;
    end;

implementation

const
     MinGripSize = 0;

{ TVScrollBar }

Constructor TVScrollBar.Create(Parent: TScreen; X, Y, Height:Integer);
begin
     X1:=X;
     X2:=X;
     Y1:=Y+1;
     Y2:=Y1+Height-2;
     TrackSize:= Height-2;
     btn_Up:= TSmallButton.Create(Parent,X,Y,#24,Black,White,Red,White);
     btn_Down:= TSmallButton.Create(Parent,X2,Y2+1,#25,Black,White,Red,White);
     WindowSize:=Height;
     ContentSize:=0;
     WindowPosition:=1;
     btn_Up.OnClick:= @btn_UpClick;
     btn_Down.OnClick:=@btn_DownClick;
     self.OnClick_Down:=@Dummy_ScrollClick;
     self.OnClick_Up:=@Dummy_ScrollClick;
     inherited Create(Parent, X1, Y1, X2, Y2);
end;

procedure TVScrollBar.UpdateContentSize(Size: Integer);
begin
     ContentSize:= Size;
     Draw;
end;

procedure TVScrollBar.UpdateWindowPosition(Position: Integer);
begin
     WindowPosition:= Position;
     Draw;
end;

procedure TVScrollBar.SetWindowSize(Size: Integer);
begin
     WindowSize:= Size;
     Draw;
end;

procedure TVScrollBar.Draw;
Var
   windowContentsRatio:real;
   windowPositionRatio:real;
   windowAreaSize:Integer;
   trackAreaSize:Integer;
   gripPosition:Integer;
   i:integer;

begin
     If ContentSize = 0 then begin
        windowContentsRatio:= 1;
     end else begin
         windowContentsRatio:= windowSize / contentSize;
     end;
     gripSize:= Round(trackSize * windowContentsRatio);
     if gripSize < MinGripSize then gripSize:= MinGripSize;
     if gripSize > trackSize then gripSize:= trackSize;
     windowAreaSize:= contentSize - WindowSize;
     if windowAreaSize = 0 then begin
        windowPositionRatio:= 0;
     end else begin
        windowPositionRatio:= windowPosition / windowAreaSize;
     end;
     trackAreaSize:= trackSize - gripSize;
     gripPosition:= trunc(trackAreaSize * windowPositionRatio);
     For i:=Y1 to Y2 do begin
         Screen.DrawCharXY(GetTag,X1,i,#178,white,black);
     end;
     For i:=Y1+gripPosition to Y1+GripPosition+gripSize do begin
         Screen.DrawCharXY(GetTag,X1,i,' ',black,black);
     end;
end;

procedure TVScrollBar.btn_UpClick;
begin
     _OnClick_Up;
end;

procedure TVScrollBar.btn_DownClick;
begin
     _OnClick_Down;
end;

procedure TVScrollBar.Dummy_ScrollClick;
begin
     //Do nothing
end;

procedure TVScrollBar.SetVisible(Vis: Boolean);
begin
     btn_Up.Visible:= Vis;
     btn_Down.Visible:= Vis;
     inherited SetVisible(Vis);
end;

{ Callback Events }

procedure TVScrollBar._OnKeyPress(Key: Char);
begin
     inherited _OnKeyPress(Key);
end;

procedure TVScrollBar._OnMouseEnter;
begin
     inherited _OnMouseEnter;
end;

procedure TVScrollBar._OnMouseLeave;
begin
     inherited _OnMouseLeave;
end;

procedure TVScrollBar._OnClick;
begin
     inherited _OnClick;
end;

procedure TVScrollBar._OnLoseFocus;
begin
     inherited _OnLoseFocus;
end;

end.

